package ipinterfaces;

#########################################################################
#									#
# Name:	 	ipinterfaces.pm (Perl Module)				#
#									#
# Completed:	8th October, 2003.					#
#									#
# REWRITTRN:	3rd January, 2013.					#
#									#
# Author:	Simon Edwards, Advantsys Computer Services Ltd.		#
#									#
# Arguments:	N/A							#
#									#
# Purpose:	This module contains a series of routines for 		#
# 		performing various checks and actions aimed at IPv4	#
# 		handling for the linuxha codebase.			#
#									#
# Limitations:	1 - Lots probably.					#
#									#
# Environment:	None.							#
#									#
# Exit Codes:	N/A							#
# 									#
#########################################################################

BEGIN {
	if(!exists($::ENV{LINUXHA_LIBS})) {
		$::ENV{LINUXHA_LIBS}="/opt/linuxha14/lib/perl";
	}
	push @INC,$::ENV{LINUXHA_LIBS};
}

use Carp qw(cluck);
use Data::Dumper;
use Net::Ping;
eval { require "miitoollib.pm"; } ;
eval "use Net::Interface qw(:ifs);" ;

my $ping6=1;
eval 'use ping6;';
if($@) {
	$ping6=0;
}
# use strict;
# Can take remote=>node to get details via ssh of remote node.

sub new {
my $proto=shift;
my $class=ref($proto) || $proto;
my $self={};
my %args=@_;

	#################################################################
	# Required, since have_link might use either, unless forced	#
	# to use a certain one.						#
	#################################################################
	$self->{MIITOOLLIB}=0;
	$self->{ETHTOOLLIB}=0;
	$self->{ETHTOOL}=0;
	if(defined(&miitoollib::ethtoolquery)) {
		$self->{ETHTOOLLIB}=1;
	}
	if(defined(&miitoollib::miiquery)) {
		$self->{MIITOOLLIB}=1;
	}
	if(-x "/sbin/ethtool") {
		$self->{ETHTOOL}=1;
	}
	$self->{MIITOOLLIB_SEND_ARP}=defined(&miitoollib::send_arp);
	if(exists($args{remote})) {
		$self->{remote}=$args{remote};
	}
        eval '@F=Net::Interface->interfaces;';
	if(defined($F[0])) {
		$self->{NET_INTERFACES}=1;
	} else {
		$self->{NET_INTERFACES}=0;
	}
	bless($self,$class);
	scan_interfaces($self);
	return $self;
}

sub scan_interfaces {
my $self=shift;
my (%interfaces,$fd,$cint,$no,$int);
my ($ip,$bcast,$mask,$hw);

	%interfaces=();
	$self->{scantime}=time;
	if(1==2 && $self->{NET_INTERFACES} && !exists($self->{remote})) {
		my (@F,$MAC,$i);
		foreach $int (Net::Interface->interfaces ()) {
			$cint=$int->name;
			next if $cint eq "lo";
			if($cint !~ /:/) {
				$cint.=":0";
			}
			my @ip4=$int->address(AF_INET);
			my @ip6=$int->address(AF_INET6);
			my @A=(); my @B=();
			for my $cip4 (@ip4) {
				push @A,inet_ntoa($cip4);
			}
			for my $cip6 (@ip6) {
				push @B,inet_ntop(inet_ntoa($cip6));
			}
			if(@A) {
				$interfaces{"$cint"}->{ip}=$A[0];
			}
			if(@B) {
				$interfaces{"$cint"}->{ip6}=$B[0];
			}
			$interfaces{"$cint"}->{broadcast}=join(".", unpack("C*", $int->broadcast));
			$interfaces{"$cint"}->{broadcast6}=inet_ntop($int->broadcast(AF_INET6));
			$interfaces{"$cint"}->{netmask}=join(".", unpack("C*", $int->netmask));
			$interfaces{"$cint"}->{netmask6}=mask2cidr($int->netmask(AF_INET6));
			if(@A) {
				$interfaces{"$cint"}->{network}=_return_network($A[0],
									$interfaces{"$cint"}->{netmask});
			}
			if(@B) {
				$interfaces{"$cint"}->{network}=_return_network6($B[0],
									$interfaces{"$cint"}->{netmask6});
			}
			$MAC="";
			@F = split('', uc(unpack("H*", $int->hwaddress)));
			for($i=0;$i<scalar @F;$i+=2){
				$MAC.=($i+2<scalar @F ? "$F[$i]$F[$i+1]:" : "$F[$i]$F[$i+1]");
			}

			$interfaces{"$cint"}->{mac}=$MAC;
			$interfaces{"$cint"}->{slave}=0;
		}
		$self->{interfaces}=\%interfaces;
		return;
	}
	$cmd="/sbin/ip addr list";
	if($self->{remote}) {
		$cmd="ssh ".$self->{remote}." -o batchmode=yes $cmd";
	}
	if(!open($fd,"$cmd|")) {
		$self->{interfaces}={};
		return;
	}

	#################################################################
	# We use 'ip' to get all ip interface details.			#
	#################################################################

	my @ipv6=();
	my @ipv4=();
	my $state=0;
	my $slave=0;
	while(<$fd>) {
		chomp;
		if(/^\d+:\s([a-z0-9]+):/) {
			my $zz=$1;
			if(defined($cint)) {
				$interfaces{"$cint:0"}={};
				if(defined($hw)) {
					$interfaces{"$cint:0"}->{mac}=$hw;
				}
				$interfaces{"$cint:0"}->{state}=$state;
				$interfaces{"$cint:0"}->{slave}=$slave;
				$interfaces{"$cint:0"}->{ip4}=[@ipv4]; # array of addr,netmask,brdcast
				$interfaces{"$cint:0"}->{ip6}=[@ipv6]; # array of addr,netmask,scope
			}
			$state=$slave=0;
			$cint=$zz;
			@ipv6=();
			@ipv4=();
			$hw=undef;
			if(/state (UP|UNKNOWN)/) {
				$state=1;
			}
			if(/SLAVE\s+/) {
				$slave=1;
			}
			next;
		}
		s/^\s+//;
		my @F=split;
		if($F[0] eq "link/ether") {
			$hw=$F[1];next;
		}
		if($F[0] eq "inet") {
			my @F2=split(/\//,$F[1]);
			my $cnet=_return_network($F2[0],$F2[1]);
			push @ipv4,[$F2[0],$F2[1],$F[3],$cnet]; # ip, mask, broadcast, network
			next;
		}
		if($F[0] eq "inet6") {
			if(/scope link/) {
				next;
			}
			my @F2=split(/\//,$F[1]);
			my $cnet=_return_network6($F2[0],$F2[1]);
			push @ipv6,[$F2[0],$F2[1],$F[3],$cnet]; # ip, mask, scope, network
			next;
		}
	}
	if(defined($cint)) {
		$interfaces{"$cint:0"}={};
		if(defined($hw)) {
			$interfaces{"$cint:0"}->{mac}=$hw;
		}
		$interfaces{"$cint:0"}->{state}=$state;
		$interfaces{"$cint:0"}->{slave}=$slave;
		$interfaces{"$cint:0"}->{ip4}=[@ipv4]; # array of addr,netmask,brdcast,network
		$interfaces{"$cint:0"}->{ip6}=[@ipv6]; # array of addr,netmask,scope,network
	}
	$self->{interfaces}=\%interfaces;
	close($fd);
}

#########################################################################
# This will return a list of physical or logical interfaces names	#
# Must use logical => 1 or physical => 1				#
# If physical == 1 then one list of interfaces is returned. If		#
# logical == 1 then list of two refs - ipv4 list and ipv6 list.		#
#########################################################################

sub list {
my $self=shift;
my @nlist;
my %args=@_;

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{logical}) && !exists($args{physical})) {
		return undef;
	}
	my @i4=(); my  @i6=();
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}
	@nlist=();
	if(!exists($args{logical})) {
		return map {s!:0$!!; $_;} (keys %{$self->{interfaces}});
	} else {
		foreach (keys %{$self->{interfaces}}) {
			my $phy=$_; $phy =~ s/:\d+$//;
			my $x=0;
			for my $y (@{$self->{interfaces}->{$_}->{ip4}}) {
				push @i4,"$phy:$x";
				$x++;
			}
			$x=0;
			for my $y (@{$self->{interfaces}->{$_}->{ip6}}) {
				push @i6,"$phy:$x";
				$x++;
			}
		}
	}
	return ([@i4],[@i6]);
}

#########################################################################
# Given an interface it will return the number of the next logical	#
# interface that can be assigned to.					#
#########################################################################

sub get_logical {
my $self=shift;
my %args=@_;
my ($int,$try);

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{interface})) {
		return -1;
	}
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}

	$int=$args{interface};
	if(!exists($self->{interfaces}->{"$int:0"})) {
		return -2;
	}
	$try=1;
	while(exists($self->{interfaces}->{"$int:$try"})) {
		$try++;
	}
	return $try;
}

sub exp_ipv6_addr {
my $self=shift;
my $a;
	if(ref($self)) {
		$a=shift;
	} else {
		$a=$self;
	}

	my ($mask) = $a =~ /\/(\d+)$/;
	$a =~ s/\/\d+$//; # strip off mask if necessary
	my @H=split(/:/,$a);
	my @H2=();
	my $b="";
	my $expand=8;
	for my $c (@H) {
		if(!defined($c) || !length($c)) {
			push @H2,""; next;
		}
		push @H2,sprintf("%04x",hex($c));
		$expand--;
	}
	$a=join(":",@H2);
	if($expand) {
		my $x="0000:" x $expand;
		$a =~ s/^::/$x/;
		$a =~ s/::/:$x/;
	}
	if(wantarray) {
		return ($a,$mask);
	} else {
		return $a;
	}
}

#########################################################################
# Given an IP address this will return the $cint:$no of the		#
# interface, or undef if no such ip address is currently assigned.	#
# Can be 6| or IP6| prefixed to indicate the address given is IPv6.	#
# In this case the address is expanded to ensure it matches the 	#
# values we currently have stored.					#
#########################################################################

sub get_interface {
my $self=shift;
my %args=@_;
my @d;

	#################################################################
	# 0109: Put a check here to see if multiple IP addresses	#
	#	have been passed and issue a warning if so...		#
	#################################################################
	@d=split(/,/,$args{ip});
	if(scalar(@d)>1) {
		print STDERR "GET_INTERFACE: Multiple IPs passed - choosing first!\n";
		$args{ip}=(split(/,/,$args{ip}))[0];
	}

	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{ip})) {
		return undef;
	}
	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+30<time) {
		scan_interfaces($self);
	}
	my $type="ip4";
	if($args{ip} =~ /:/) {
		$type="ip6";
		if(substr($args{ip},0,1) eq '[') {
			$args{ip}=substr($args{ip},1,length($args{ip})-2);
		}
	}

	foreach (keys %{$self->{interfaces}}) {
		next if ! exists($self->{interfaces}->{$_}->{$type});
		next if ! defined($self->{interfaces}->{$_}->{$type});
		my $intn=0;
		my $ccard=$_; $ccard =~ s/:\d+$//;
		for my $ce (@{$self->{interfaces}->{$_}->{$type}}) {
			if($type eq "ip6") {
				if(exp_ipv6_addr($ce->[0]) eq exp_ipv6_addr($args{ip})) {
					return "$ccard:$intn";
				}
			} else {
				if($ce->[0] eq $args{ip}) {
					return "$ccard:$intn";
				}
			}
			$intn++;
		}
	}
	return undef;
}

#########################################################################
# The following routine takes an interface and checks to see if it	#
# has linked connectivity. It expects to have the following flags:	#
# interface, [always]							#
# Note:	If the interface is virtual (eth2:1) it will converted to the	#
# physical (eth2).							#
# Return codes are as follows:						#
# 1 - link beat ok							#
# 0 - no link beat							#
# 2 - link beat detection not supported on this interface		#
# -1 - missing / invalid argument					#
# 3 - no such interface exists						#
#########################################################################

sub have_link {
my $self=shift;
my %args=@_;
my ($interface,$phys,$log,$rc,$r);
my $method;

	$method=$args{method} if defined($args{method});
	if(!exists($self->{scantime})) {
		$self->{scantime}=0;
	}
	if(!exists($args{interface})) {
		return (-1,"Missing arg");
	}
	if(!defined($args{interface})) {
		return (-1,"Undefined arg");
	}
	$interface=$args{interface};

	if(exists($args{always})) {
		scan_interfaces($self);
	} elsif($self->{scantime}+60<time) {
		scan_interfaces($self);
	}

	if($interface =~ /:/) {
		($phys,$log)=($interface =~ /(.*):(.*)/);
	} else {
		($phys,$log)=($interface,0);
	}

	if(!exists($self->{interfaces}->{"$phys:0"})) {
		return (3,"Physical interface $phys does not exist");
	}
	if(($self->{MIITOOLLIB}==0 && $self->{ETHTOOLLIB}==0 && $self->{ETHTOOL}==0) || 
		(defined($method) && $method eq "MIIDIAG")) {
		if(! -f "/opt/linuxha14/tools/mii-diag") {
			return (2,"Link beat not supported on $phys");
		}
		$r=`/opt/cluster/mii-diag $phys 2>&1`;

	#################################################################
	# APPLICATION_RC is set by the SIGCHLD handler in the main	#
	# program, so check for that variable first...			#
	#################################################################
		if(defined($::APPLICATION_RC)) {
			$rc=$::APPLICATION_RC;
		} else {
			$rc=$?>>8;
		}
		if($r =~ /You have link beat/ || $r =~ /link ok/) {
			return (1,"Link beat OK","MIIDIAG");
		}
		if($r =~ /Operation not supported/) {
			return (2,"Link beat not supported on $phys");
		}
		return (0,"No link beat detected on interface $phys","MIIDIAG");
	} elsif(($self->{ETHTOOLLIB}==1 && !defined($method)) ||
			(defined($method) && $method eq "ETHTOOLLIB")) {
		$r=miitoollib::ethtoolquery($phys);
		return(0,"No link beat detected on interface $phys","ETHTOOLLIB") if !$r;
		return(1,"Link beat OK","ETHTOOLLIB") if $r==1;
	} elsif(($self->{MIITOOLLIB}==1 && !defined($method)) ||
		(defined($method) && $method eq "MIITOOLLIB")) {
		#########################################################
		# If we get here ETHTOOLLIB not supported on specified	#
		# interface, so attempt to use the other one...		#
		#########################################################
		$r=miitoollib::miiquery($phys);
		if($r =~ /You have link beat/ || $r =~ /link ok/) {
			return (1,"Link beat OK","MIITOOLLIB");
		}
		if($r !~ /Operation not supported/) {
			return (0,"No link beat detected on interface $phys","MIITOOLLIB");
		}
	} elsif($self->{ETHTOOL}) {
		#########################################################
		# If we get here try to use ethtool if available as	#
		# a last resort.					#
		#########################################################
		my ($fd,$cline,@F);
		open($fd,"/sbin/ethtool $phys|");
		@F=grep {/Link detected:/} <$fd>;
		close($fd);
		if(@F) {
			my $x=$F[$#F];
			if($x =~ /yes/) {
				return (1,"Link beat OK","ETHTOOL");
			}
			return(0,"No link beat detected on interface $phys","ETHTOOL");
		}
	}
	return(2,"Link beat not supported on $phys");
}

#########################################################################
#									#
# This routine will take details of the IP information to ping and 	#
# will return the following:						#
# (1,results)	- IP interface is working as expected			#
# (0,results)	- Ping results below threshold, so might consider	#
# 		  moving the interface.					#
# (-1,str)	- Other error occured.					#
# 		  							#
# The following arguments are expected:					#
# 									#
# ips		- Optional list of ip addresses to try			#
# 		  This can include IPv6 values if they are prefixed	#
#		  by 6| or IP6|						#
# [succeed]	- Percentage of IP address over which the interface	#
# 		  is thought to be valid. Defaults to 100.		#
# [pingtype]	- Type of ping to use (defaults to udp).		#
#		  If IPv6 addresses are being tested these will		#
#		  always be done using icmp6.				#
# [pingtimeout]	- Timeout for ping (default to 2 seconds)		#
# [logmsg]	- Function to send log messages to.			#
# [logwarn]	- Function to send warn messages to.			#
# [usearp]	- Whether to send gratuitous arp when an IP address	#
#		  is assigned to an interface.				#
# [usesrcaddr]	- Bind the ping routine to the interface specified as	#
# 		  this variable.					#
#									#
#########################################################################

# XXX: herer
sub ip_check {
my $self=shift;
my %args=@_;
my ($ips,$succeed,$pingtype);
my ($cip,$count,$okcount,$str);
my ($pinger,$pingtimeout,$logmsg,$logwarn);
my ($srcaddr,$bindip);

	if(!exists($args{ips})) {
		return (-1,"Missing ip or interfaces argument");
	}
	if(!defined($args{ips})) {
		return (-1,"undefined ip or interfaces argument");
	}

	$ips=$args{ips};
	$succeed=$args{succeed} if exists($args{succeed});
	$pingtype=$args{pingtype} if exists($args{pingtype});
	$pingtimeout=$args{pingtimeout} if exists($args{pingtimeout});
	$logmsg=$args{logmsg} if exists($args{logmsg});
	$logwarn=$args{logwarn} if exists($args{logwarn});
	$succeed=100 if !defined($succeed);
	$pingtype="udp" if !defined($pingtype);
	$pingtimeout=2 if !defined($pingtimeout);

	if(exists($args{usesrcaddr})) {
		$srcaddr=$args{usesrcaddr};
		if(exists($self->{interfaces}->{"$srcaddr:0"}) &&
			exists($self->{interfaces}->{"$srcaddr:0"}->{ip})) {
				$bindip=$self->{interfaces}->{"$srcaddr:0"}->{ip};
		}
	}
	$count=0;
	$okcount=0;
	$pinger=Net::Ping->new($pingtype,$pingtimeout);

	#################################################################
	# We only attempt to perform the bind if the version of 	#
	# Net::Ping actually supports it - version 5.6.x do not.	#
	#################################################################

	if(defined($bindip)) {
		if(defined(&Net::Ping::bind)) {
			$pinger->bind($bindip);
		} else {
			&$logwarn("Bind method not available for Net::Ping!") if defined($logwarn);
		}
	}

	my $rc;
	foreach $cip (split(/,/,$ips)) {
		# Check if IPv6 addr and treat accordingly.
		if($cip =~ /:/) {
			my $i=$cip;
			if(substr($i,0,1) eq '[') {
				$i=substr($i,1,length($i)-2);
			}
			$rc=ping6($i,$pingtimeout);
			if($rc!=1) {
				$rc=0;
			}
		} else {
			$rc=$pinger->ping($cip);
		}
		if($rc) {
			$okcount++;
		}
		$count++;
	}
	if($okcount/$count*100>=$succeed) {
		return (1,int($okcount/$count*100));
	} else {
		return (0,int($okcount/$count*100));
	}
}

#########################################################################
# Return the list of routes currently associated with a particular	#
# interface. It returns a list where each element is:			#
# IPDEST:GATEWAY:FLAGS:GENMASK						#
# eg: 192.168.0.0:0.0.0.0:U:255.255.255.0,0.0.0.0:192.168.0.1:UG	#
#									#
# Requires the following argument:					#
# interface:	The name of the interface to get the routes for -	#
#		such as eth0 - routine will strip of logical interface	#
#		information if passed.					#
#########################################################################

sub get_routes {
my $self=shift;
my %args=@_;
my (@l,@F,$cmd,$cline,$fd,$i);

	@l=();
	return() if !exists($args{interface});
	$i=$args{interface};
	$i =~ s/:.*//;
	$cmd="netstat -nr|";
	open($fd,$cmd) or return();
	while($cline=<$fd>) {
		chomp $cline;
		next if $cline !~ /^[0-9]{1,3}/;
		@F=split(/\s+/,$cline);
		next if $F[$#F] ne $i;
		push @l,"$F[0]:$F[1]:$F[3]:$F[2]";
	}
	close($fd);
	return @l;
}

#########################################################################
# set_routes takes the list of routines in the format generated by	#
# get_routes and applies them to a particular interface.		#
# Returns a list of any routes that could not be set.			#
# If the destination already exists on that interface a new one will	#
# not be set up.							#
# Requires the following arguments:					#
# interface	The name of the interface to set the routes up on.	#
# routes	A reference to a list of routes to configure.		#
#########################################################################

sub set_routes {
my $self=shift;
my %args=@_;
my (@r,$cmd,@F,@F2,@r2,$x,$f,$i,@b);

	@b=();
	die("Missing routes argument") if !exists($args{routes});
	@r=@{$args{routes}};
	die("Missing interface argument") if !exists($args{interface});
	$i=$args{interface};
	$i =~ s/:.*//;

	#################################################################
	# firstly get a list of current routes on the new interface.	#
	#################################################################

	@r2=get_routes($self,interface=>$i);

	for (@r) {
		@F=split(/:/,$_);
		#########################################################
		# Ensure this route is not already configured, and if	#
		# so we ignore it.					#
		#########################################################
		$f=0;
		for $x (@r2) {
			@F2=split(/:/,$x);
			if($F[0] eq $F2[0]) {
				$f=1;last;
			}
		}
		next if $f;
		# Route needs to be added, so attempt to do so.		#
		if($F[2] =~ /H/) {
			$cmd="/sbin/route add $F[0] ";
		} else {
			$cmd="/sbin/route add -net $F[0] ";
		}
		$cmd.="netmask $F[3] ";
		$cmd.="gw $F[1] " if $F[1] ne "0.0.0.0";
		$cmd.="dev $i 2>&1";

		$r=`$cmd`;
		chomp $r;
		if($r ne "") {
			push @b,$cmd;
		}
	}
	return @b;
}

sub _return_network6 {
my ($ipaddr,$netmask)=@_;

	my $ex=exp_ipv6_addr($ipaddr);
	my $l=length($ex)-1;
	while($netmask) {
		if($netmask>=4) {
			$ex=substr($ex,0,$l) . "0" . substr($ex,$l+1);
			$netmask-=4;
			$l--;
			if($l && substr($ex,$l,1) eq ":") {
				$l--;
			}
		} else {
			# XXX just the hex value of the 1-3 bits, set those to 0
			my $y=1<<$netmask; $y=15-$y;
			my $he=hex(substr($ex,$l,1));
			my $x=sprintf("%x",$he & $y);
			$ex=substr($ex,0,$l-1) . $x . substr($ex,$l+1);
			last;
		}
	}
	return $ex;
}

sub _return_network {
my ($ipaddr,$netmask)=@_;
my (@a,@b,@c,$i);

	if($netmask =~ /\./) {
		@a=split(/\./,$ipaddr);
		@b=split(/\./,$netmask);
		for($i=0;$i<4; $i++) {
			$c[$i]=int($a[$i]) & int($b[$i]);
		}
		return join(".",@c);
	}
	# Network is first $netmask bits of $ipaddr
	@a=split(/\./,$ipaddr);
	my $ip=(int($a[0])<<24) + (int($a[1])<<16) + (int($a[2])<<8) + int($a[3]);
	my $mm=2**$netmask-1; $mm <<= (32-$netmask); $ip&=$mm;
	return(sprintf("%d.%d.%d.%d",($ip & 0xff000000)>>24, ($ip & 0xff0000)>>16, ($ip & 0xff00)>>8,  $ip & 0xff));
}

sub get_details2 {
my $self=shift;
my %args=@_;

	return(undef) if !exists($args{interface});
	my $interface=$args{interface};
	if($interface !~ /:0$/) {
		cluck("get_details2 should only be called with card:0 instance.");
		return undef;
	}
	if(exists($self->{interfaces}->{$interface})) {
		return $self->{interfaces}->{$interface};
	}
	return undef;
}

1;

